unit PakFile;

interface

uses
  Dlzo,
  Windows,
  Sysutils,
  Debug,
  Head;

Type

  TPakdataHead = record
    FileID: integer;
    Offset: integer;
    filelen: integer;  //原始大小
  end;

  TFileList = record
    Filenum: integer;
    Filename: array of string;
  end;

  TPakstruct = record
    Headstr: array[0..7] of byte;
    Filenum: integer;
    PakDataHead: array of Tpakdatahead;
  end;

  TPakFile = class
  var
    bufferlen : integer;
    databuffer: array of byte;
  const
    PAKFILE_HEAD: AnsiString = 'PACKAGE';
    BLOCK_SIZE: integer = $10000;
  public
    constructor Create;
    Destructor Destroy; override;
    procedure Release;
    procedure ClearBuffer;
    function HashFileName(fn: PAnsichar): Cardinal;
    function HashUnicodeFileName(str: Widestring): Cardinal;
    function unpak(Psource: Pbyte; sourcelen: integer; Pdata: Pbyte; len: integer): integer;
    function pak(Pin_data: Pbyte; sourcelen: integer; Pout_data: Pbyte): integer;
    function ReadFromFile(PakFileName: String; FileName: string; Pout: Pbyte; buflen: integer): integer;
    function ReadFromFileToBuffer(PakFileName: String; FileName: string): integer;
    function GetFilelen(PakFileName: string; FileName: string): integer; overload;
    function GetFilelen(PakFileName: string; FileID: cardinal): integer; overload;
  end;

  PPakFile = ^TPakFile;

implementation

constructor TPakFile.Create;
begin
  inherited;
  bufferlen := 0;
  setlength(databuffer, 0);
end;

Destructor TPakFile.Destroy;
begin
  Release;
  inherited Destroy;
end;

procedure TPakFile.Release;
begin
  bufferlen := 0;
  setlength(databuffer, 0);
end;

procedure TPakFile.ClearBuffer;
begin
  bufferlen := 0;
  setlength(databuffer, 0);
end;

function TPakFile.HashFileName(fn: PAnsichar): Cardinal;
var
  cnt,data,remainder,total: cardinal;
  ch: Ansichar;//Shortint;
begin
  cnt := 0;
  total := 0;
  ch := fn^;
  while (shortint(ch) <> 0) do
  begin
		if(ch=Ansichar('/')) then
      ch:=Ansichar('\');
		if((ch>='A') and (ch<='Z')) then
      shortint(ch):=$20 + shortint(ch);
    inc(cnt);
    data:=shortint(ch)*cnt+total ;
    remainder:= not(data mod $8000000b) +1;
    total:=((remainder) shl 4)+remainder;
    inc(fn);
    ch:=fn^;
  end;
  result := total xor $12345678;
end;

function TPakFile.HashUnicodeFileName(str: Widestring): Cardinal;
begin
  result := HashFileName(PAnsiChar(WideSTRtoAnsi(str)));
end;

function TPakFile.unpak(Psource: Pbyte; sourcelen: integer; Pdata: Pbyte;
  len: integer): integer;
var
  I, pos: integer;
  datalen, templen, totallen: integer;
  slen: integer;
begin
  I := 0;
  pos := 0;
  templen := 0;
  totallen := 0;
  slen := sourcelen;
  while True do
  begin
    datalen := Pword(Psource + I)^;
    inc(I, 2);
    if datalen = 0 then
    begin
      if slen >= BLOCK_SIZE + 2 then
        datalen := BLOCK_SIZE
      else
        datalen := slen - 2;
      templen := datalen;
      if pos + datalen > len then
        templen := len - pos;
      copymemory(Pbyte(Pdata + pos), Pbyte(Psource + I), templen);
      templen := datalen;
    end
    else
       Decompress(Pbyte(Psource + I), datalen, Pbyte(Pdata + pos), templen);
      //templen := LzoDecode(Pbyte(Psource + I), datalen, Pbyte(Pdata + pos));
    inc(I, datalen);
    inc(pos, templen);
    totallen := templen + totallen;
    dec(slen, datalen + 2);
    if I >= sourcelen then
      break;
  end;
  result := totallen;// - len;
end;

function TPakFile.pak(Pin_data: Pbyte; sourcelen: integer; Pout_data: Pbyte): integer;
var
  tempbuffer: array[0 .. (65536 + 65536 div 10 + 1024)] of byte;
  databuffer: array[0..65535] of byte;
  Pdata,psource: Pbyte;
  I, pos, blocknum: integer;
  datalen, templen, totallen: integer;
begin
  //
  pdata := Pout_data;
  psource := Pin_data;
  templen := sourcelen;
  totallen := 0;
  while(templen >= BLOCK_SIZE) do
  begin
    CopyMemory(@databuffer[0], psource, BLOCK_SIZE);
    psource := psource + BLOCK_SIZE;
    Compress(@databuffer[0], BLOCK_SIZE, @tempbuffer[0], datalen);
    //datalen := LzoEncode(@databuffer[0],BLOCK_SIZE, @tempbuffer[0]);
    if datalen >= BLOCK_SIZE then
    begin
      Pword(Pdata)^ := 0;
      Pdata:= Pdata+ 2;
      copymemory(Pdata, @databuffer[0], BLOCK_SIZE);
      Pdata:= Pdata+ BLOCK_SIZE;
      inc(totallen, 2 + BLOCK_SIZE);
    end
    else
    begin
      Pword(Pdata)^ := Word(datalen);
      Pdata:= Pdata+ 2;
      copymemory(Pdata, @tempbuffer[0], datalen);
      Pdata:= Pdata+ datalen;
      inc(totallen, 2 + datalen);
    end;
    DEC(templen,BLOCK_SIZE);
  end;
  if templen > 0 then
  begin
    CopyMemory(@databuffer[0], psource, templen);
    //psource := psource + BLOCK_SIZE;
    Compress(@databuffer[0],templen,@tempbuffer[0], datalen);
    //datalen := LzoEncode(@databuffer[0],templen,@tempbuffer[0]);
    if datalen >= templen then
    begin
      Pword(Pdata)^ := 0;
      Pdata:= Pdata+ 2;
      copymemory(Pdata, @databuffer[0], templen);
      Pdata:= Pdata+ templen;
      inc(totallen, 2 + templen);
    end
    else
    begin
      Pword(Pdata)^ := datalen;
      Pdata:= Pdata+ 2;
      copymemory(Pdata, @tempbuffer[0], datalen);
      Pdata:= Pdata+ datalen;
      inc(totallen, 2 + datalen);
    end;
  end;
  result := totallen;
end;

function TPakFile.ReadFromFile(PakFileName: String; FileName: string; Pout: Pbyte; buflen: integer): integer;
var
  temp: integer;
begin
  temp := ReadFromFileToBuffer(PakFileName, FileName);
  if temp < 0 then
  begin
    result := temp;
    exit;
  end;

  if temp > buflen then
  begin
    Move(databuffer[0], Pout^, buflen);
  end
  else if temp > 0 then
  begin
    Move(databuffer[0], Pout^, temp);
  end;

  result := temp;

end;

function TPakFile.ReadFromFileToBuffer(PakFileName: String; FileName: string): integer;
var
  FH, I, Filelen: Integer;
  Pakstruct: TPakstruct;
  tempdata: array of byte;
  FileID: Cardinal;
  isFind: boolean;
begin
  //
  if not Fileexists(PakFileName) then
  begin
    result := -1;
    exit;
  end;

  FH := Fileopen(PakFIleName, fmopenread);
  Filelen := FileSeek(FH, 0, 2);
  fileseek(FH, 0, 0);
  fileread(FH, Pakstruct.Headstr[0], length(Pakstruct.Headstr));
  fileread(FH, Pakstruct.Filenum, 4);
  setlength(Pakstruct.PakDataHead, Pakstruct.Filenum);
  Fileread(FH, Pakstruct.PakDataHead[0], Pakstruct.Filenum * sizeof(TPakDataHead));

  FileID := HashFilename(PAnsichar(StrtoAnsi(FileName)));

  isFind := false;
  for I := 0 to Pakstruct.Filenum - 1 do
  begin
    if FileID = Pakstruct.PakDataHead[I].FileID then
    begin
      isFind := true;
      break;
    end;
  end;

  if isFind then
  begin
    if I = PakStruct.FileNum - 1 then
    begin
      Filelen := Filelen - PakStruct.PakDataHead[I].Offset;
    end
    else
    begin
      Filelen := PakStruct.PakDataHead[I + 1].Offset - PakStruct.PakDataHead[I].Offset;
    end;
    fileseek(FH, PakStruct.PakDataHead[I].Offset, 0);
    setlength(tempdata, Filelen);
    fileread(FH, tempdata[0], Filelen);
    fileclose(FH);
    bufferlen := PakStruct.PakDataHead[I].filelen;
    setlength(databuffer, bufferlen);
    if unpak(@tempdata[0], Filelen, @databuffer[0], bufferlen) <> PakStruct.PakDataHead[I].filelen then
    begin
      result := -2;
      exit;
    end;
    result := PakStruct.PakDataHead[I].filelen;
    exit;
  end
  else
  begin
    fileclose(FH);
    result := -3;
    exit;
  end;

end;

function TPakFile.GetFilelen(PakFileName: string; FileName: string): integer;
var
  FileID: Cardinal;
begin
  //
  FileID := HashFilename(PAnsichar(StrtoAnsi(FileName)));
  result := GetFilelen(PakFileName, FileID);
end;

function TPakFile.GetFilelen(PakFileName: string; FileID: cardinal): integer;
var
  FH, I, Filelen: Integer;
  Pakstruct: TPakstruct;
  isFind: boolean;
begin
  //
  if not Fileexists(PakFileName) then
  begin
    result := -1;
    exit;
  end;

  FH := Fileopen(PakFIleName, fmopenread);
  Filelen := FileSeek(FH, 0, 2);
  fileseek(FH, 0, 0);
  fileread(FH, Pakstruct.Headstr[0], length(Pakstruct.Headstr));
  fileread(FH, Pakstruct.Filenum, 4);
  setlength(Pakstruct.PakDataHead, Pakstruct.Filenum);
  Fileread(FH, Pakstruct.PakDataHead[0], Pakstruct.Filenum * sizeof(TPakDataHead));

  isFind := false;
  for I := 0 to Pakstruct.Filenum - 1 do
  begin
    if FileID = Pakstruct.PakDataHead[I].FileID then
    begin
      isFind := true;
      break;
    end;
  end;

  if isFind then
  begin
    result := PakStruct.PakDataHead[I].filelen;
  end
  else
  begin
    fileclose(FH);
    result := -2;
    exit;
  end;
end;

end.
